home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
Serial Toolkit
/
Source Code
/
recvUpTo.p
< prev
next >
Wrap
Text File
|
1988-11-18
|
8KB
|
279 lines
(*
recvUpTo(termination character, waitTime,oldString) -- Return a string from the
serial port; return everything available, up to the termination character (if any). Pass an empty
termination character to receive everything available. WaitTime is the amount of time to wait
for the input, in ticks (60ths of a second). oldString is what was read the last call (presumably
terminated due to a time-out).
To compile and link this file using Macintosh Programmer's Workshop,
pascal -w recvUpTo.p
link -m ENTRYPOINT -o HyperCommands -rt XFCN=7032 -sn Main=recvUpTo ∂
recvUpTo.p.o "{MPW}"Libraries:interface.o
© Copyright 1987,88 by Apple Computer, Inc.
Initial coding 9/87 by Harry R. Chesley.
*)
{$R-}
{$S recvUpTo } { Segment name must be the same as the command name. }
unit DummyUnit;
interface
uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
procedure EntryPoint(paramPtr: XCmdPtr);
implementation
const
return = 13; { Carriage return. }
linefeed = 10; { Line feed. }
bs = 8; { Back space. }
delete = 127; { Delete. }
space = ord(' '); { Space. }
tab = 9; { Horizontal tab. }
type
Str31 = String[31];
procedure recvUpTo(paramPtr: XCmdPtr); forward;
procedure EntryPoint(paramPtr: XCmdPtr);
begin
recvUpTo(paramPtr);
end;
procedure recvUpTo(paramPtr: XCmdPtr);
var str: Str255;
l: longInt;
waitForChars: longInt; { Ticks to wait until for characters (compated to TickCount). }
lookForTerm: boolean; { True if we're looking for a terminator character. }
termChar: signedByte; { The terminator character we're looking for. }
resultHand: Handle; { A handle to the result string. }
resultSize: longInt; { The size of the result string (minus the zero termination tacked on last). }
theChar: signedByte;
p, p2: Ptr;
col: integer; { The current column. }
i,j: integer;
{$I XCmdGlue.inc}
procedure Fail(errMsg: Str255); { set theResult and quit }
begin
paramPtr^.returnValue := PasToZero(errMsg);
exit(recvUpTo);
end;
{$I SPortUtil.inc}
procedure sendByte(b: SignedByte);
{ Send one byte out the port. }
var l: longInt;
begin
l := 1;
if FSWrite(ThisSPort.portOutDev,l,@b) <> noErr then Fail('FSWrite failed');
end;
procedure sendCRLF;
{ Send a carriage return/linefeed out the port. }
begin
sendByte(return); sendByte(linefeed);
end;
procedure sendBS;
{ Backspace on a terminal attached to the port: backspace, then space to erase any character in the
previous position, then backspace again to get the cursor in the right place. }
begin
sendByte(bs); sendByte(space); sendByte(bs);
end;
procedure disposAndFail(err: str255);
{ Fail routine used after the result handle has been allocated. }
begin
DisposHandle(resultHand);
Fail(err);
end;
begin
if paramPtr^.paramCount <> 3 then Fail('parameter count is not 3');
SetUpSPortGlobals;
EnsureOpenPort;
GetStrParm(1,str); { First parameter is termination character. }
if length(str) = 0 then lookForTerm := false
else
begin
lookForTerm := true;
termChar := SignedByte(str[1]);
end;
waitForChars := GetLongParm(2); { Second parameter is whether to wait. }
resultHand := paramPtr^.params[3]; { Third parameter is the old string. }
{ If there's anything in the "previous" string, copy it. }
if resultHand <> NIL then
begin
p := resultHand^;
resultSize := 0;
while p^ <> 0 do
begin
resultSize := resultSize + 1;
p := Ptr(ord4(p)+1);
end;
if resultSize < 0 then Fail('Input string size too small!');
if HandToHand(resultHand) <> noErr then Fail('HandToHand failed!');
SetHandleSize(resultHand,resultSize);
end
{ On the other hand, if the previous string is empty, make a new, empty one. }
else
begin
resultHand := NewHandle(0);
resultSize := 0;
end;
{ Get our current idea of where the other side's cursor is. }
col := ThisSPort.currentColumn;
{ Figure out when to stop trying (timeout). }
waitForChars := waitForChars + TickCount;
{ Cycle until the timeout happens or we see the termintor character. }
while true do
begin
{ Check if there's any input from the port. }
if SerGetBuf(ThisSPort.portInDev,l) <> noErr then disposAndFail('SerGetBuf failed');
{ If not, do another round or get out, depending on the timeout condition. }
if l = 0 then
begin
if TickCount > waitForChars then leave
else cycle;
end;
{ Expand the result handle and read in the first character that's waiting. }
resultSize := resultSize+1;
SetHandleSize(resultHand,resultSize);
if MemError <> noErr then disposAndFail('SetHandleSize failed!');
HLock(resultHand);
l := 1;
if FSRead(ThisSPort.portInDev,l,Ptr(ord4(resultHand^)+resultSize-1)) <> noErr then
disposAndFail('FSRead failed');
HUnlock(resultHand);
{ Strip the character, if appropriate, and then get it into theChar. }
p := Ptr(ord4(resultHand^)+resultSize-1);
if ThisSPort.stripIncoming then p^ := BAND(p^,$7F);
theChar := p^;
{ Weed out control characters, if appropriate. }
if ThisSPort.stripControls then
if (theChar < space) and (theChar <> tab) and (theChar <> return) and (theChar <> bs) then
begin
resultSize := resultSize-1;
SetHandleSize(resultHand,resultSize);
cycle;
end;
{ If we're echoing... }
if ThisSPort.doEcho then
begin
{ If this is a backspace... }
if ThisSPort.doEdit and ((theChar = bs) or (theChar = delete)) then
begin
if (col > 1) and (resultSize > 1) then
begin
sendBS;
col := col-1;
end;
end
{ If it's a carriage return... }
else if theChar = return then
begin
sendCRLF;
col := 1;
end
{ If it's a normal, non-wrapped character... }
else if (col < WRAPCOLUMN) or (not ThisSPort.autoWrap) then
begin
sendByte(theChar);
col := col+1;
end
{ If it's a space in the wrap column (which only allows spaces)... }
else if (theChar = space) and (col = WRAPCOLUMN) then
begin
sendByte(space);
col := col+1;
end
{ Otherwise, wrap the last word of the line onto the next line... }
else
begin
{ Figure out how many characters will wrap... }
p := pointer(ord4(resultHand^)+resultSize);
i := 0;
while p <> resultHand^ do
begin
p := pointer(ord4(p)-1);
if (p^ = space) or (p^ = return) then leave;
i := i+1;
end;
{ If it's the entire line, forget it. }
if i >= MAXWRAP then i := 1;
{ If there's nothing to wrap, then just send a carriage return/linefeed. }
if i = 0 then i := 1
{ Otherwise, backspace thru the characters being wrapped, then go to the next
line, then send the wrapping characters. }
else
begin
if i > 1 then for j := 1 to i-1 do sendBS;
sendCRLF;
for j := resultSize-i to resultSize-1 do
sendByte(Ptr(ord4(resultHand^)+j)^);
end;
col := i+1;
end;
end;
{ If we're editing this line and this is the edit character... }
if ThisSPort.doEdit and (theChar = bs) or (theChar = delete) then
begin
{ Eliminate the backspace character. }
resultSize := resultSize-1;
{ If we're allowed to edit it (i.e., it isn't on the previous line on the screen),
eliminate the erased character. }
if (col >= 1) or (not ThisSPort.doEcho) then resultSize := resultSize-1;
{ Make sure we're not deleting more than there is. }
if resultSize < 0 then resultSize := 0;
{ Delete it. }
SetHandleSize(resultHand,resultSize);
end;
if lookForTerm and (theChar = termChar) then leave;
if resultSize > 30000 then leave;
end;
{ Add in the zero termination for the string. }
SetHandleSize(resultHand,resultSize+1);
p := ptr(ord4(resultHand^)+resultSize);
p^ := 0;
{ Return the handle. }
paramPtr^.returnValue := resultHand;
{ Remember where we think the cursor column is. }
Globals^^.ports[Globals^^.selectedPort].currentColumn := col;
end;
end.